home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_gimp.idb / usr / freeware / share / gimp / scripts / 3dTruchet.scm.z / 3dTruchet.scm
Encoding:
Text File  |  1999-07-21  |  6.2 KB  |  190 lines

  1. ; The GIMP -- an image manipulation program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; This program is free software; you can redistribute it and/or modify
  5. ; it under the terms of the GNU General Public License as published by
  6. ; the Free Software Foundation; either version 2 of the License, or
  7. ; (at your option) any later version.
  8. ; This program is distributed in the hope that it will be useful,
  9. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. ; GNU General Public License for more details.
  12. ; You should have received a copy of the GNU General Public License
  13. ; along with this program; if not, write to the Free Software
  14. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ;
  16. ;    3dTruchet  - a script to create Truchet patterns 
  17. ;                 by Adrian Likins <aklikins@eos.ncsu.edu>
  18. ;                 http://www4.ncsu.edu/~aklikins/
  19. ;    version about .8 give or take
  20. ;
  21. ;  Lots of thanks to Quartic for his help.
  22. ;
  23. ;
  24. ;         The utility of this script is left as an exercise for the reader.
  25.  
  26. (define (center-ellipse img cx cy rx ry op aa feather frad)
  27.   (gimp-ellipse-select img (- cx rx) (- cy ry) (+ rx rx ) (+ ry ry ) op aa feather frad))
  28.  
  29. (define (use-tile img drawable height width img2 drawable2 xoffset yoffset)
  30.   (gimp-edit-copy img2 drawable2)
  31.   (let ((floating-sel (car (gimp-edit-paste img drawable FALSE))))
  32.     (gimp-layer-set-offsets floating-sel xoffset yoffset)
  33.     (gimp-floating-sel-anchor floating-sel)
  34.     )
  35.   )
  36.  
  37.  
  38. (define (create-tile img drawable1 drawable2 size thickness backcolor begincolor endcolor supersample)
  39.   (let* (
  40.      (half-thickness (/ thickness 2))
  41.      (outer-radius (+ (/ size 2) half-thickness))
  42.      (inner-radius (- (/ size 2) half-thickness))
  43.      )
  44.  
  45.     (gimp-selection-all img)
  46.     (gimp-palette-set-background backcolor)
  47.     (gimp-edit-fill img drawable1)
  48.  
  49.     (let* (
  50.        (tempSize (* size 3))
  51.        (temp-img (car (gimp-image-new tempSize tempSize RGB))) 
  52.        (temp-draw (car (gimp-layer-new temp-img tempSize tempSize RGB_IMAGE "Jabar" 100 NORMAL)))
  53.              (temp-draw2 (car (gimp-layer-new temp-img tempSize tempSize RGB_IMAGE "Jabar" 100 NORMAL))))
  54.  
  55.       (gimp-image-disable-undo temp-img)
  56.       (gimp-image-add-layer temp-img temp-draw 0)
  57.       (gimp-image-add-layer temp-img temp-draw2 0)
  58.       (gimp-palette-set-background backcolor)
  59.       (gimp-edit-fill temp-img temp-draw)
  60.       (gimp-edit-fill temp-img temp-draw2)
  61.  
  62.       ;weird aint it
  63.       (gimp-palette-set-background begincolor)
  64.       (gimp-palette-set-foreground endcolor)
  65.  
  66.       (center-ellipse temp-img size size outer-radius outer-radius REPLACE TRUE FALSE 0)
  67.       (center-ellipse temp-img size size inner-radius inner-radius SUB TRUE FALSE 0)
  68.       
  69.       (center-ellipse temp-img (* size 2) (*  size 2)  outer-radius outer-radius ADD TRUE FALSE 0)
  70.       (center-ellipse temp-img (* size 2) (*  size 2)  inner-radius inner-radius SUB TRUE FALSE 0)
  71.       (gimp-blend temp-img temp-draw FG-BG-RGB NORMAL SHAPEBURST-ANGULAR 100 0 FALSE supersample 3 .2 size size (* size 2) (/ size 2) )
  72.  
  73.       (center-ellipse temp-img size (* size 2)  outer-radius outer-radius REPLACE TRUE FALSE 0)
  74.       (center-ellipse temp-img size (* size 2) inner-radius inner-radius SUB TRUE FALSE 0)
  75.  
  76.       (center-ellipse temp-img (* size 2) size  outer-radius outer-radius ADD TRUE FALSE 0)
  77.       (center-ellipse temp-img (* size 2) size  inner-radius inner-radius SUB TRUE FALSE 0)
  78.       ;(gimp-edit-fill temp-img temp-draw2)
  79.       (gimp-blend temp-img temp-draw2 FG-BG-RGB NORMAL SHAPEBURST-ANGULAR 100 0 FALSE supersample 3 .2 size size (* size 2) (* size 2) )
  80.       
  81.       (gimp-selection-none temp-img)
  82.  
  83.       (gimp-image-resize temp-img size size (- size) (- size))
  84.       ; woo hoo it works....finally...
  85.  
  86.  
  87.       (gimp-selection-all temp-img)
  88.       (gimp-edit-copy temp-img temp-draw)
  89.       (let ((floating-sel (car (gimp-edit-paste img drawable2 FALSE))))
  90.     (gimp-floating-sel-anchor floating-sel))
  91.  
  92.       (gimp-edit-copy temp-img temp-draw2)
  93.       (let ((floating-sel (car (gimp-edit-paste img drawable1 FALSE))))
  94.     (gimp-floating-sel-anchor floating-sel))
  95.  
  96.       ;(let ((drawble (car (gimp-flip img drawable1 0)))))
  97.     
  98.  
  99.       ;(gimp-display-new temp-img)
  100.       (gimp-image-delete temp-img)
  101.       )
  102.     )
  103.   )
  104.  
  105.  
  106. (define (script-fu-3dtruchet size thickness backcolor begincolor endcolor supersample xtiles ytiles)
  107.   (let* (     
  108.      (width (* size xtiles))
  109.      (height (* size ytiles))
  110.      (img (car (gimp-image-new width height RGB)))
  111.      (tile (car (gimp-image-new size size RGB)))
  112.      (layer-one (car (gimp-layer-new img width height RGB "Rambis" 100 NORMAL)))
  113.      (tiledraw1 (car (gimp-layer-new tile size size RGB "Johnson" 100 NORMAL)))
  114.      (tiledraw2 (car (gimp-layer-new tile size size RGB "Cooper" 100 NORMAL)))
  115.      (Xindex 0)
  116.      (Yindex 0) 
  117.      )
  118.  
  119.     (gimp-image-disable-undo img)
  120.     (gimp-image-disable-undo tile)
  121.     
  122.     (gimp-image-add-layer img layer-one 0)
  123.     (gimp-image-add-layer tile tiledraw1 0)
  124.     (gimp-image-add-layer tile tiledraw2 0)
  125.  
  126.  
  127.     ;just to look a little better
  128.     (gimp-selection-all img)
  129.     (gimp-palette-set-background backcolor) 
  130.     (gimp-edit-fill img layer-one)
  131.     (gimp-selection-none img)
  132.  
  133.     (create-tile tile tiledraw1 tiledraw2 size thickness backcolor begincolor endcolor supersample)
  134.     
  135.  
  136.     (while (<= Xindex xtiles)
  137.        (while (<= Yindex ytiles)
  138.           (if (= (rand 2) 0)
  139.               (use-tile img layer-one height width tile tiledraw1 (* Xindex size) (* Yindex size))
  140.               (use-tile img layer-one height width tile tiledraw2 (* Xindex size) (* Yindex size))
  141.               )
  142.           (set! Yindex (+ Yindex 1))
  143.           )
  144.        (set! Yindex 0)
  145.        (set! Xindex (+ Xindex 1))
  146.        )
  147.     
  148.     
  149.     (gimp-image-delete tile)
  150.     (gimp-display-new img)
  151.     (gimp-image-enable-undo img)
  152.     )
  153.   )
  154.  
  155. (script-fu-register "script-fu-3dtruchet"
  156.             "<Toolbox>/Xtns/Script-Fu/Patterns/3D Truchet"
  157.             "3D Truchet pattern"
  158.             "Adrian Likins <aklikins@eos.ncsu.edu>"
  159.             "Adrian Likins"
  160.             "1997"
  161.             ""
  162.             SF-VALUE "Block Size" "64"
  163.             SF-VALUE "Thickness" "12"
  164.             SF-COLOR "Background Color" '(255 255 255)
  165.             SF-COLOR "Begin Blend" '(0 0 0)
  166.             SF-COLOR "End Blend" '(255 255 255)
  167.             SF-VALUE "Supersample" "TRUE"
  168.             SF-VALUE "Number of Xtiles" "5"
  169.             SF-VALUE "Number of Ytiles" "5"
  170.             )
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.